home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / qb2 / pro20 / syscheck.bas < prev    next >
Encoding:
BASIC Source File  |  1988-11-05  |  16.0 KB  |  544 lines
  1. '╔═════════════════════════════════════════════════════════════════════════╗
  2. '║                                                                         ║
  3. '║                             SYSCHECK.BAS                                ║
  4. '║                                                                         ║
  5. '║                                                                         ║
  6. '║               written with Microsoft QuickBASIC v4.00b                  ║
  7. '║                                                                         ║
  8. '╠═════════════════════════════════════════════════════════════════════════╣
  9. '║                                                                         ║
  10. '║  NOTE:                                                                  ║
  11. '║                                                                         ║
  12. '║  THIS  PROGRAM,  ITS USE,  OPERATION,  AND SUPPORT IS PROVIDED "AS IS"  ║
  13. '║  WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING,  ║
  14. '║  BUT NOT LIMITED TO,  THE IMPLIED  WARRANTIES  OF  MERCHANTABILITY AND  ║
  15. '║  FITNESS FOR A PARTICULAR PURPOSE.   THE ENTIRE RISK AS TO THE QUALITY  ║
  16. '║  AND PERFORMANCE OF THIS PROGRAM IS WITH THE USER.   IN NO EVENT SHALL  ║
  17. '║  MICROSOFT BE LIABLE FOR  DAMAGES INCLUDING,  WITHOUT LIMITATION,  ANY  ║
  18. '║  LOST PROFITS,  LOST  SAVINGS,  OR OTHER  INCIDENTAL OR  CONSEQUENTIAL  ║
  19. '║  DAMAGES ARISING FROM  THE USE OR INABILITY TO USE THIS PROGRAM,  EVEN  ║
  20. '║  IF MICROSOFT HAS BEEN ADVISED OF THE  POSSIBILTY OF SUCH DAMAGES,  OR  ║
  21. '║  FOR ANY CLAIM BY ANY OTHER PARTY.                                      ║
  22. '║                                                                         ║
  23. '╚═════════════════════════════════════════════════════════════════════════╝
  24. '
  25. ' SysCheck.BAS - System Equipment Check
  26. '
  27. ' Written by Kyle Sparks, Microsoft, 1988
  28. '
  29. '
  30.  
  31.    DEFINT A-Z
  32.  
  33.    TYPE Register
  34.         ax    AS INTEGER
  35.         bx    AS INTEGER
  36.         cx    AS INTEGER
  37.         dx    AS INTEGER
  38.         bp    AS INTEGER
  39.         si    AS INTEGER
  40.         di    AS INTEGER
  41.         flags AS INTEGER
  42.         ds    AS INTEGER
  43.         es    AS INTEGER
  44.    END TYPE
  45.  
  46. '-------------------- Declare Procedures and Functions ----------------------
  47.  
  48. '- - - - - - - - - - - Procedures in QB.QLB - - - - - - - - - - - - - - - - -
  49.  
  50.    DECLARE SUB Interrupt (intnum AS INTEGER, inreg AS Register, outreg AS Register)
  51.    DECLARE SUB InterruptX (intnum AS INTEGER, inreg AS Register, outreg AS Register)
  52.  
  53. '- - - - - - - - - - - Procedures contained internally  - - - - - - - - - - -
  54.  
  55.    DECLARE FUNCTION BytesAvail& (Drive$)
  56.    DECLARE FUNCTION ConvDate$ (d$)
  57.    DECLARE FUNCTION Compaq$ (Default$)
  58.    DECLARE FUNCTION GetDrive$ ()
  59.    DECLARE FUNCTION GetPath$ (Drive$)
  60.    DECLARE FUNCTION SetVideoSegment% ()
  61.  
  62.    DECLARE SUB CoPrint (f%, b%, m$)
  63.    DECLARE SUB Initialize ()
  64.    DECLARE SUB MakeBox (Left%, Top%, Right%, Bottom%, Border%)
  65.    DECLARE SUB MoveToScreen (x1%, y1%, x2%, y2%, Buffer() AS INTEGER)
  66.    DECLARE SUB MoveFromScreen (x1%, y1%, x2%, y2%, Buffer() AS INTEGER)
  67.    DECLARE SUB PopUp ()
  68.    DECLARE SUB ScrRstr (x$)
  69.    DECLARE SUB ScrSave (x$)
  70.    DECLARE SUB ShowComputerType ()
  71.    DECLARE SUB ShowDisketteDrives ()
  72.    DECLARE SUB ShowDriveMimic ()
  73.    DECLARE SUB ShowInitVidMode ()
  74.    DECLARE SUB ShowMathCoproc ()
  75.    DECLARE SUB ShowPrinters ()
  76.    DECLARE SUB ShowROMDate ()
  77.    DECLARE SUB ShowSerialPorts ()
  78.    DECLARE SUB ShowTotalRAM ()
  79.  
  80. '------------------ Declare local and global variables ----------------------
  81.  
  82.    COMMON SHARED x1, y1, x2, y2
  83.    COMMON SHARED Attrib1, Attrib2, Attrib3, Attrib6, Attrib4
  84.    COMMON SHARED Attrib5, Attrib7
  85.  
  86. '------------------------------ MAIN PROGRAM --------------------------------
  87.  
  88. 'BEGIN
  89.  
  90.    Initialize
  91.    PopUp
  92. END
  93.  
  94. FUNCTION BytesAvail& (Drive$)
  95. '----------------------------------------------------------------------------
  96. '  function BytesAvail returns the number of bytes available on Drive$
  97. '----------------------------------------------------------------------------
  98.  
  99.    DIM regs AS Register
  100.  
  101.    regs.ax = &H3600
  102.    regs.dx = ASC(Drive$) - 64
  103.    Interrupt &H21, regs, regs
  104.    Bytes& = regs.ax * regs.cx
  105.    BytesAvail& = regs.bx * Bytes&
  106.  
  107. END FUNCTION
  108.  
  109. FUNCTION Compaq$ (Default$)
  110. '----------------------------------------------------------------------------
  111. '  function Compaq$ check to see if the current machine is a COMPAQ brand
  112. '  computer.  If so, the value returned is "COMPAQ" else Default$ is returned
  113. '----------------------------------------------------------------------------
  114.   
  115.    a$ = ""               ' Start with a blank string.
  116.    DEF SEG = &HF000      ' ROM Bios area.
  117.    FOR I = 0 TO 5
  118.        a$ = a$ + CHR$(PEEK(&HFFEA + I))
  119.    NEXT
  120.    DEF SEG               ' Back to BASIC.
  121.   
  122.    IF a$ = "COMPAQ" THEN
  123.       Compaq$ = a$
  124.    ELSE
  125.       Compaq$ = Default$
  126.    END IF
  127.  
  128.  
  129. END FUNCTION
  130.  
  131. FUNCTION ConvDate$ (d$)
  132. '----------------------------------------------------------------------------
  133. '  function ConvDate$ converts the date into a MMMMMMMM DD, YYYY format.
  134. '----------------------------------------------------------------------------
  135.  
  136.    SELECT CASE LEFT$(d$, 2)
  137.       CASE "01"
  138.          r$ = r$ + "January "
  139.       CASE "02"
  140.          r$ = r$ + "February "
  141.       CASE "03"
  142.          r$ = r$ + "March "
  143.       CASE "04"
  144.          r$ = r$ + "April "
  145.       CASE "05"
  146.          r$ = r$ + "May "
  147.       CASE "06"
  148.          r$ = r$ + "June "
  149.       CASE "07"
  150.          r$ = r$ + "July "
  151.       CASE "08"
  152.          r$ = r$ + "August "
  153.       CASE "09"
  154.          r$ = r$ + "September "
  155.       CASE "10"
  156.          r$ = r$ + "October "
  157.       CASE "11"
  158.          r$ = r$ + "November "
  159.       CASE "12"
  160.          r$ = r$ + "December "
  161.       CASE ELSE
  162.    END SELECT
  163.  
  164.    ConvDate$ = r$ + MID$(d$, 4, 2) + ", 19" + RIGHT$(d$, 2)
  165.  
  166. END FUNCTION
  167.  
  168. SUB CoPrint (f, b, m$)
  169. '----------------------------------------------------------------------------
  170. '   procedure CoPrint prints m$ with forground color f and backround color b.
  171. '----------------------------------------------------------------------------
  172.  
  173.    COLOR f, b
  174.    IF RIGHT$(m$, 1) = ";" THEN
  175.       PRINT LEFT$(m$, LEN(m$) - 1);
  176.    ELSE
  177.       PRINT m$
  178.    END IF
  179.  
  180. END SUB
  181.  
  182. FUNCTION GetDrive$
  183. '------------------------------------------------------------------------
  184. '  function GetDrive$ returns the current active DOS drive letter.
  185. '------------------------------------------------------------------------
  186.  
  187.    DIM regs AS Register
  188.    regs.ax = &H1900
  189.    Interrupt &H21, regs, regs
  190.    GetDrive$ = CHR$(65 + regs.ax MOD 256)
  191.  
  192. END FUNCTION
  193.  
  194. FUNCTION GetPath$ (Drive$)
  195. '------------------------------------------------------------------------
  196. '  function GetPath$ returns the current active DOS path on the specified
  197. '------------------------------------------------------------------------
  198.  
  199.    DIM regs AS Register, sb AS STRING * 64
  200.    regs.ax = &H4700
  201.    regs.dx = ASC(Drive$) - 64
  202.    regs.ds = VARSEG(sb)
  203.    regs.si = VARPTR(sb)
  204.    InterruptX &H21, regs, regs
  205.    GetPath$ = LEFT$(sb, INSTR(sb, CHR$(0)) - 1)
  206.  
  207. END FUNCTION
  208.  
  209. SUB Initialize
  210. '----------------------------------------------------------------------------
  211. '  procedure Initialize sets up colors and global parameters for the program.
  212. '----------------------------------------------------------------------------
  213.  
  214.    DEF SEG = 0
  215.  
  216.    SELECT CASE PEEK(&H449)
  217.  
  218.       CASE 2, 7
  219.           Attrib0 = 0       'Black
  220.           Attrib1 = 9       'High Intensity Underline
  221.           Attrib2 = 0       'Black
  222.           Attrib3 = 7       'White
  223.           Attrib4 = 7       'White
  224.           Attrib5 = 0       'Black
  225.           Attrib6 = 7       'White
  226.           Attrib7 = 15      'High intensity white
  227.       CASE 3
  228.           Attrib0 = 0       'Black
  229.           Attrib1 = 1       'Blue
  230.           Attrib2 = 3       'Cyan
  231.           Attrib3 = 4       'Red
  232.           Attrib4 = 5       'Magenta
  233.           Attrib5 = 7       'White
  234.           Attrib6 = 0       'Black
  235.           Attrib7 = 6       'Orange
  236.      
  237.       CASE ELSE
  238.   
  239.    END SELECT
  240.  
  241.    x1 = 10
  242.    x2 = 70
  243.    y1 = 4
  244.    y2 = 21
  245.  
  246.    COLOR Attrib0, Attrib0
  247.  
  248.    LOCATE , , 0
  249.  
  250. END SUB
  251.  
  252. SUB MakeBox (Left, Top, Right, Bottom, Border)
  253. '----------------------------------------------------------------------------
  254. '  procedure MakeBox draws a box on the screen starting at Top, Left and
  255. '  ending at Bottom, Right using either no border, or a single or double
  256. '  line border based on the value of Border.
  257. '----------------------------------------------------------------------------
  258.  
  259.    SELECT CASE Border
  260.       CASE 1
  261.           VertLine$ = CHR$(179)
  262.          HorizLine$ = CHR$(196)
  263.             UpLeft$ = CHR$(218)
  264.            UpRight$ = CHR$(191)
  265.            LowLeft$ = CHR$(192)
  266.           LowRight$ = CHR$(217)
  267.  
  268.       CASE 2
  269.           VertLine$ = CHR$(186)
  270.          HorizLine$ = CHR$(205)
  271.             UpLeft$ = CHR$(201)
  272.            UpRight$ = CHR$(187)
  273.            LowLeft$ = CHR$(200)
  274.           LowRight$ = CHR$(188)
  275.  
  276.       CASE ELSE
  277.           VertLine$ = CHR$(32)
  278.          HorizLine$ = CHR$(32)
  279.             UpLeft$ = CHR$(32)
  280.            UpRight$ = CHR$(32)
  281.            LowLeft$ = CHR$(32)
  282.           LowRight$ = CHR$(32)
  283.  
  284.    END SELECT
  285.  
  286.    LOCATE Top, Left
  287.    PRINT UpLeft$; STRING$((Right - Left) - 1, HorizLine$); UpRight$;
  288.    FOR Y = Top + 1 TO Bottom - 1
  289.       LOCATE Y, Left
  290.       PRINT VertLine$; SPACE$((Right - Left) - 1); VertLine$;
  291.    NEXT Y
  292.    LOCATE Bottom, Left
  293.    PRINT LowLeft$; STRING$((Right - Left) - 1, HorizLine$); LowRight$;
  294.  
  295. END SUB
  296.  
  297. SUB PopUp
  298. '----------------------------------------------------------------------------
  299. '  procedure Popup is the main control procedure for the program.  I makes
  300. '  the main window and performs the various functions of the program.
  301. '----------------------------------------------------------------------------
  302.  
  303.    OldY = CSRLIN
  304.  
  305.    DOSScreen$ = SPACE$(4000)
  306.    ScrSave DOSScreen$
  307.    COLOR Attrib3, Attrib5
  308.  
  309.    MakeBox x1, y1, x2, y2, 2
  310.   
  311.    LOCATE y1 + 2, x1 + 19
  312.    CoPrint Attrib1, Attrib5, "Hardware System Check"
  313.  
  314.    LOCATE y1 + 4, x1 + 2
  315.    ShowComputerType
  316.    LOCATE y1 + 5, x1 + 2
  317.    ShowROMDate
  318.    LOCATE y1 + 7, x1 + 2
  319.    ShowDriveMimic
  320.    LOCATE y1 + 9, x1 + 14
  321.    ShowPrinters
  322.    LOCATE y1 + 10, x1 + 14
  323.    ShowSerialPorts
  324.    LOCATE y1 + 11, x1 + 14
  325.    ShowDisketteDrives
  326.    LOCATE y1 + 12, x1 + 11
  327.    ShowInitVidMode
  328.    LOCATE y1 + 13, x1 + 13
  329.    ShowMathCoproc
  330.    LOCATE y1 + 14, x1 + 11
  331.    ShowTotalRAM
  332.    LOCATE y1 + 16, x1 + 12
  333.    COLOR Attrib7, Attrib5
  334.    PRINT USING " ###,###,###"; BytesAvail&(GetDrive$); :
  335.    COLOR Attrib6, Attrib5
  336.    PRINT " Bytes Free on Drive ";
  337.    CoPrint Attrib7, Attrib5, GetDrive$ + ": ;"
  338.   
  339.    WHILE INKEY$ = "": WEND
  340.   
  341.    ScrRstr DOSScreen$
  342.  
  343.    LOCATE OldY
  344.  
  345. END SUB
  346.  
  347. SUB ShowComputerType
  348. '----------------------------------------------------------------------------
  349. '  procedure ShowComputerType retrieves and displays the type of processor
  350. '  and, if applicable, the brand of the computer.
  351. '----------------------------------------------------------------------------
  352.  
  353.  
  354.    DEF SEG = &HF000
  355.    COLOR Attrib6, Attrib5
  356.    PRINT "This is a";
  357.    
  358.    SELECT CASE PEEK(&HFFFE)
  359.       CASE 45
  360.          PRINT "n 8088 Compaq";
  361.       CASE 154
  362.          PRINT "n 8086 Compaq Plus";
  363.       CASE 252
  364.          PRINT "n 80286 based "; Compaq("AT (or compatible)");
  365.       CASE 253
  366.          PRINT " PCjr";
  367.       CASE 254
  368.          PRINT "n 8086 based "; Compaq("XT (or compatible) ");
  369.       CASE 255
  370.          PRINT "n 8088 based "; Compaq("PC (or compatible)");
  371.       CASE ELSE
  372.       PRINT "n unknown computer";
  373.   
  374.    END SELECT
  375.  
  376.    DEF SEG
  377.   
  378. END SUB
  379.  
  380. SUB ShowDisketteDrives
  381. '----------------------------------------------------------------------------
  382. ' procedure ShowDisketteDrives shows the number of diskette drives installed.
  383. '----------------------------------------------------------------------------
  384.   
  385.    DEF SEG = 0
  386.  
  387.    NumDrives = (PEEK(&H410) \ 64) + 1
  388.    PRINT "Diskette Drives: ";
  389.    CoPrint Attrib7, Attrib5, STR$(NumDrives) + " ;"
  390.    COLOR Attrib4, Attrib5
  391.  
  392. END SUB
  393.  
  394. SUB ShowDriveMimic
  395. '----------------------------------------------------------------------------
  396. '  procedure ShowDriveMimic shows whether or not drive mimic is on (A: is
  397. '  acting as a logical drive B:).
  398. '----------------------------------------------------------------------------
  399.  
  400.    DEF SEG = 0
  401.    
  402.    IF PEEK(&H504) = 1 THEN
  403.       PRINT "Drive Mimic is ";
  404.       CoPrint Attrib7, Attrib5, "ON ;"
  405.       CoPrint Attrib6, Attrib5, " (physical A: now acting as logical B:)"
  406.    ELSE
  407.       PRINT "Drive Mimic is ";
  408.       CoPrint Attrib7, Attrib5, "OFF;"
  409.       CoPrint Attrib6, Attrib5, " (physical A: not acting as logical B:)"
  410.    END IF
  411.  
  412.    DEF SEG
  413.  
  414. END SUB
  415.  
  416. SUB ShowInitVidMode
  417. '----------------------------------------------------------------------------
  418. '  procedure ShowInitVidMode shows the primary video mode at boot time.
  419. '----------------------------------------------------------------------------
  420.  
  421.    DIM Message$(3)
  422.    Message$(0) = " <Not Available> "
  423.    Message$(1) = " 40-Column Color "
  424.    Message$(2) = " 80-Column Color "
  425.    Message$(3) = " 80-Column MONO  "
  426.  
  427.    DEF SEG = &H40
  428.  
  429.    ModeNum = (PEEK(&H10) \ 2 ^ 4) AND 3
  430.    PRINT "Initial Video Mode: ";
  431.   
  432.    IF ModeNum = 0 THEN
  433.       CoPrint Attrib3 + 16, Attrib6, Message$(0) + ";"
  434.    ELSE
  435.       CoPrint Attrib7, Attrib5, Message$(ModeNum) + ";"
  436.    END IF
  437.  
  438.    COLOR Attrib4, Attrib5
  439.  
  440.    DEF SEG
  441.  
  442. END SUB
  443.  
  444. SUB ShowMathCoproc
  445. '----------------------------------------------------------------------------
  446. '  procedure ShowMathCoproc checks to see if a math coprocessor is installed.
  447. '----------------------------------------------------------------------------
  448.  
  449.    DEF SEG = &H40
  450.  
  451.    MathCoproc = (PEEK(&H10) \ 2) AND 1
  452.  
  453.    PRINT "Math Coprocessor: ";
  454.   
  455.    IF MathCoproc = 0 THEN
  456.       CoPrint Attrib3 + 16, Attrib5, " <Not Installed> ;"
  457.    ELSE
  458.       CoPrint Attrib7, Attrib5, " Installed       ;"
  459.    END IF
  460.   
  461.    COLOR Attrib4, Attrib5
  462.  
  463.    DEF SEG
  464.  
  465. END SUB
  466.  
  467. SUB ShowPrinters
  468. '----------------------------------------------------------------------------
  469. '  procedure ShowPrinters shows the number of printer ports installed.
  470. '----------------------------------------------------------------------------
  471.  
  472.    DEF SEG = &H40
  473.  
  474.    COLOR Attrib4, Attrib5
  475.  
  476.    Printers = PEEK(&H11) \ (2 ^ 6)
  477.    PRINT "Printer Devices: ";
  478.    CoPrint Attrib7, Attrib5, STR$(Printers) + " ;"
  479.    COLOR Attrib4, Attrib5
  480.   
  481.    DEF SEG
  482.  
  483. END SUB
  484.  
  485. SUB ShowROMDate
  486. '----------------------------------------------------------------------------
  487. '  procedure ShowROMDate displays the date of the ROM programs in the
  488. '  machine.
  489. '----------------------------------------------------------------------------
  490.  
  491.    ROMDate$ = ""
  492.   
  493.    DEF SEG = &HF000
  494.  
  495.    FOR p = &HFFF5 TO &HFFFD
  496.       ROMDate$ = ROMDate$ + CHR$(PEEK(p))
  497.    NEXT p
  498.    
  499.    IF LEFT$(ROMDate$, 1) = CHR$(32) THEN
  500.         ROMDate$ = RIGHT$(ROMDate$, LEN(ROMDate$) - 1)
  501.    ELSE
  502.         ROMDate$ = LEFT$(ROMDate$, LEN(ROMDate$) - 1)
  503.    END IF
  504.  
  505.   
  506.    DEF SEG
  507.  
  508.    PRINT "ROMs are dated "; ConvDate$(ROMDate$); "."
  509.  
  510. END SUB
  511.  
  512. SUB ShowSerialPorts
  513. '----------------------------------------------------------------------------
  514. '  procedure ShowSerialPorts shows the number of serial ports installed.
  515. '----------------------------------------------------------------------------
  516.  
  517.    DEF SEG = &H40
  518.   
  519.    NumSerial = (PEEK(&H11) \ 2) AND 7
  520.   
  521.    PRINT " Serial Devices: ";
  522.    CoPrint Attrib7, Attrib5, STR$(NumSerial) + " ;"
  523.    COLOR Attrib4, Attrib5
  524.   
  525.    DEF SEG
  526.  
  527. END SUB
  528.  
  529. SUB ShowTotalRAM
  530. '----------------------------------------------------------------------------
  531. '  procedure ShowTotalRAM displays the total amount of RAM installed.
  532. '----------------------------------------------------------------------------
  533.  
  534.    DEF SEG = &H40
  535.  
  536.    TotalRAM = PEEK(&H13) + (PEEK(&H14) * 256)
  537.    PRINT "Total On-Board RAM: ";
  538.    CoPrint Attrib7, Attrib5, STR$(TotalRAM) + "k ;"
  539.    COLOR Attrib4, Attrib5
  540.  
  541.    DEF SEG
  542. END SUB
  543.  
  544.